home *** CD-ROM | disk | FTP | other *** search
/ Internet Surfer: Getting Started / Internet Surfer - Getting Started (Wayzata Technology)(7231)(1995).bin / pc / mac / bonus / peter_le / finger-1 / fingerd / fingerd.p
Text File  |  1992-02-24  |  6KB  |  242 lines
  1. {$I-}
  2. program Fingerd;
  3.  
  4. { This code is part of the Finger/Fingerd source code, written in THINK Pascal 4 }
  5. { Copyright 1991-1992 Peter N Lewis }
  6. { If you use this code, you must give me credit in your about box and documentation }
  7.  
  8.     uses
  9.         AppleTalk, PPCToolbox, Processes, EPPC, Notification, AppleEvents, {}
  10.         TCPTypes, TCPStuff, FingerDaemon, PrefsGlobals, Folders, MyUtilities, MyPreferences;
  11.  
  12.     const
  13.         strh_id = 128;
  14.         prefname_index = 1;
  15.         pref_launch_str = 2;
  16.         quitnow_index = 3;
  17.         lf = 10;
  18.         daemons_max = 10;
  19.  
  20.     var
  21.         quitNow: boolean;
  22.  
  23.     function GotRequiredParams (theAppleEvent: AppleEvent): OSErr;        { <aevt> }
  24.         var
  25.             typeCode: DescType;
  26.             actualSize: Size;
  27.             err: OSErr;
  28.     begin
  29.         err := AEGetAttributePtr(theAppleEvent, keyMissedKeywordAttr, typeWildCard, typeCode, nil, 0, actualSize);    { nil ok: need only function result }
  30.         if err = errAEDescNotFound then        { we got all the required params: all is ok }
  31.             GotRequiredParams := noErr
  32.         else if err = noErr then
  33.             GotRequiredParams := errAEEventNotHandled
  34.         else
  35.             GotRequiredParams := err;
  36.     end; { GotRequiredParams }
  37.  
  38.     function HandleQUIT (theAppleEvent, reply: AppleEvent; quitp: ptr): OSErr;        { <aevt> }
  39.         var
  40.             oe: OSErr;
  41.             errStr: Str255;
  42.             willQuit: Boolean;                { did the user allow the quit or cancel }
  43.     begin
  44.     { We don't expect any params at all, but check in case the client requires any }
  45.         oe := GotRequiredParams(theAppleEvent);
  46.         quitNow := true;
  47.         if reply.dataHandle <> nil then            { a reply is sought }
  48.             begin
  49.             if oe = noErr then
  50.                 errStr := 'OK'
  51.             else
  52.                 errStr := 'user cancelled quit';
  53.             oe := AEPutParamPtr(reply, 'errs', 'TEXT', Ptr(@errStr[1]), length(errStr));
  54.         end;
  55.         HandleQUIT := oe;
  56.     end;
  57.  
  58.     function OpenPrefFile (name: str63): integer;
  59.         var
  60.             vrn: integer;
  61.             dirID: longint;
  62.             oe: OSErr;
  63.             gv: longInt;
  64.             fil: integer;
  65.     begin
  66.         oe := Gestalt(gestaltFindFolderAttr, gv);
  67.         if (oe = noErr) & (BTST(gv, gestaltFindFolderPresent)) & (FindFolder(kOnSystemDisk, kPreferencesFolderType, kCreateFolder, vrn, dirID) = NoErr) then
  68.             fil := HOpenResFile(vrn, dirID, name, fsRdPerm)
  69.         else begin
  70.             fil := OpenResFile(concat(':Preferences:', name));
  71.             if fil <> -1 then
  72.                 fil := OpenResFile(name);
  73.         end;
  74.         OpenPrefFile := fil;
  75.     end;
  76.  
  77.     procedure HandleEvents (speed: integer);
  78.         var
  79.             dummy: boolean;
  80.             er: eventRecord;
  81.             oe: OSErr;
  82.     begin
  83.         dummy := WaitNextEvent(everyEvent, er, speed, nil);
  84.         if er.what = kHighLevelEvent then
  85.             if has_AppleEvents then
  86.                 oe := AEProcessAppleEvent(er);
  87.     end;
  88.  
  89.     function StackPtr: longInt;
  90.     inline
  91.         $2E8F;
  92.  
  93.     var
  94.         tcpc: array[1..daemons_max] of TCPConnectionPtr;
  95.         t: TCPStateType;
  96.         buffer: str255;
  97.         temp: longInt;
  98.         finger_port: integer;
  99.         readPos: longInt;
  100.         f: longInt;
  101.         gotlf: boolean;
  102.         i: integer;
  103.         oe: OSErr;
  104.         appllimitP: ^longInt;
  105.         remoteIP: longInt;
  106.         quitNowStr: str15;
  107.         pref_name: str63;
  108.         defrefnum: integer;
  109.         gv: longInt;
  110.         max_daemons, this_daemon: integer;
  111.         finished: boolean;
  112.         prefs_fs: FSSpec;
  113.         prefs_rn: integer;
  114. begin
  115.     applLimitP := POINTER($130);
  116.     applLimitP^ := StackPtr - 5000;
  117. {    SetApplLimit(ptr(StackPtr - 5000));}
  118.     MaxApplZone;
  119.     MoreMasters;
  120.     GetIndString(buffer, strh_id, quitnow_index);
  121.     quitNowStr := buffer;
  122.     GetIndString(buffer, strh_id, prefname_index);
  123.     pref_name := buffer;
  124.     GetIndString(buffer, fingerd_strh, fingerd_port_index);
  125.     StringToNum(buffer, temp);
  126. {$PUSH}
  127. {$R-}
  128.     finger_port := temp;
  129. {$R-}
  130.     quitNow := false;
  131.     oe := Gestalt(gestaltAppleEventsAttr, gv);
  132.     has_AppleEvents := (oe = noErr) and (gv = 1);
  133.     if has_AppleEvents then
  134.         oe := AEInstallEventHandler(kCoreEventClass, kAEQuitApplication, @HandleQUIT, 0, false);
  135.     for i := 1 to 5 do
  136.         HandleEvents(5);
  137.     oe := TCPInit;
  138.     if oe = noErr then begin
  139.         oe := Gestalt('mtcp', gv);
  140.         if (oe = noErr) and (gv >= 1) then begin
  141.             GetIndString(buffer, fingerd_strh, daemons_max_index);
  142.             StringToNum(buffer, gv);
  143.             if gv > daemons_max then
  144.                 max_daemons := daemons_max
  145.             else if gv < 1 then
  146.                 max_daemons := 1
  147.             else
  148.                 max_daemons := gv;
  149.         end
  150.         else
  151.             max_daemons := 1;
  152.         InitDaemon;
  153.         for i := 1 to max_daemons do
  154.             tcpc[i] := nil;
  155.         for i := 1 to max_daemons do begin
  156.             oe := TCPPassiveOpen(tcpc[i], finger_port, 0, 0, nil);
  157.             if oe <> noErr then begin
  158.                 quitNow := true;
  159.                 tcpc[i] := nil;
  160.                 leave;
  161.             end;
  162.         end;
  163.         while not quitNow do begin
  164.             IdleFingers;
  165.             this_daemon := -1;
  166.             while (this_daemon < 0) and not quitNow do begin
  167.                 HandleEvents(15);
  168.                 IdleFingers;
  169.                 for i := 1 to max_daemons do
  170.                     if TCPState(tcpc[i]) <> T_Listening then
  171.                         this_daemon := i;
  172.             end;
  173.             if not quitNow then begin
  174.                 f := TickCount;
  175.                 readPos := 0;
  176.                 repeat
  177.                     HandleEvents(5);
  178.                     IdleFingers;
  179. {$PUSH}
  180. {$R-}
  181.                     oe := TCPReceiveUpTo(tcpc[this_daemon], lf, 1, @buffer[1], 255, readPos, gotlf);
  182. {$POP}
  183.                 until (oe <> noErr) or (readPos = 255) or gotlf or (TickCount > f + 60 * 60) or quitNow;
  184.                 if gotlf then begin
  185. {$PUSH}
  186. {$R-}
  187.                     buffer[0] := chr(readPos - 2);
  188. {$POP}
  189.                     quitNow := (quitNowStr <> '') and (quitNowStr = buffer);
  190.                     IdleFingers;
  191.                     oe := SysEnvirons(1, sysenv);
  192.                     oe := SetVol(nil, sysenv.sysVRefNum);
  193.                     GetPrefsFSSpec(prefs_fs);
  194.                     prefs_rn := OpenPrefsFile(prefs_fs);
  195.                     GetPrefs(prefs);
  196.                     if prefs.plan_dirID <> -1 then
  197.                         SendPlan(tcpc[this_daemon], prefs.plan_vrn, prefs.plan_dirID, prefs.plan_name, buffer)
  198.                     else
  199.                         SendPlan(tcpc[this_daemon], 0, 0, 'Plan', buffer);
  200.                     if prefs_rn <> -1 then
  201.                         CloseResFile(prefs_rn);
  202.                 end;
  203.                 oe := TCPFlush(tcpc[this_daemon]);
  204.                 oe := TCPClose(tcpc[this_daemon], nil);
  205.                 t := TCPState(tcpc[this_daemon]);
  206.                 f := TickCount;
  207.                 while (t <> T_Closed) and (TickCount < f + 60 * 60) do begin
  208.                     IdleFingers;
  209.                     HandleEvents(5);
  210.                     t := TCPState(tcpc[this_daemon]);
  211.                 end;
  212.                 oe := TCPRelease(tcpc[this_daemon]);
  213.                 if not quitNow then begin
  214.                     oe := TCPPassiveOpen(tcpc[this_daemon], finger_port, 0, 0, nil);
  215.                     if oe <> noErr then
  216.                         leave;
  217.                 end
  218.                 else
  219.                     tcpc[this_daemon] := nil;
  220.             end;
  221.         end;
  222.         for i := 1 to max_daemons do
  223.             if tcpc[i] <> nil then
  224.                 oe := TCPClose(tcpc[i], nil);
  225.         f := TickCount;
  226.         finished := false;
  227.         while not finished and (TickCount < f + 60 * 60) do begin
  228.             HandleEvents(5);
  229.             finished := true;
  230.             for i := 1 to max_daemons do
  231.                 if tcpc[i] <> nil then
  232.                     if TCPState(tcpc[i]) <> T_Closed then
  233.                         finished := false
  234.                     else begin
  235.                         oe := TCPRelease(tcpc[i]);
  236.                         tcpc[i] := nil;
  237.                     end;
  238.         end;
  239.         FinishDaemon;
  240.         TCPFinish;
  241.     end;
  242. end.